home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 2: CDPD 1
/
Almathera Ten on Ten - Disc 2: CDPD 1.iso
/
pd
/
051-075
/
071
/
amibas
/
caleidoscope
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1995-03-13
|
2KB
|
60 lines
' Caleidoscope in Basic
' by Peter Kittel, last change 5 Dec 86
PRINT " Caleidoscope in Basic"
PRINT " =====================":PRINT
PRINT "The number of BitPlanes gives the
PRINT "number of colors (6/12/30, colors
PRINT "0 and 1 not touched), but also
PRINT "speed and storage amount.
PRINT "On a 256KB Amiga ONLY USE 3!
PRINT "So: 3 means simple colors with high speed,
PRINT " 5 means subtle colors in slow motion.
PRINT
PRINT "Number of BitPlanes (3 to 5) = ? ";
WHILE a$<"3" OR a$>"5":a$=INKEY$:WEND:PRINT a$:nf=VAL(a$)
nn=INT(2^nf+0.5)-1
SCREEN 1,320,200,nf,1 ' Screen in low res (many colors possible)
x0=0:y0=0:x9=310:y9=185
WINDOW 2,"Caleidoscope (quit with q key) "+CHR$(nf+48),(x0,y0)-(x9,y9),0,1
dx=2:dy=2
x=x0:y=y0:d=2
DIM pr(nn),pg(nn),pb(nn)
FOR i=2 TO nn:PALETTE i,0,0,0:NEXT
fr=0:fg=0:fb=0:pf=0:ff=4000:fs=0
' The precise way of color modification
' is determined by variables fs and ff
' in next lines.
' Here is much room for own experiments.
WHILE INKEY$<>"q" ' infinite loop until q key pressed
fs=fs+0.1:IF fs>7 THEN fs=fs-7
ff=ff+273.16*(1+INT(COS(fs)*2.2)):IF ff>4095 THEN ff=ff-4095
fr= INT(ff)AND 15
fg=(INT(ff)AND 15*16 )/16
fb=(INT(ff)AND 15*256)/256
' reassign palette cyclically
FOR i=nn TO 3 STEP -1:pr(i)=pr(i-1):pg(i)=pg(i-1):pb(i)=pb(i-1):NEXT
pr(2)=fr/15:pg(2)=fg/15:pb(2)=fb/15 ' neue Farbe
FOR i=2 TO nn:PALETTE i,pr(i),pg(i),pb(i):NEXT
' watch for proper coordinates
xn=x+dx:IF xn<x0 OR xn>x9 THEN dx=-dx:xn=x+dx
yn=y+dy:IF yn<y0 OR yn>y9 THEN dy=-dy:yn=y+dy
x=xn:y=yn
ad=x-x0
IF x9-x<ad THEN ad=x9-x
IF y9-y<ad THEN ad=y9-y
IF y-y0<ad THEN ad=y-y0
d=d+1:IF ad<d THEN d=ad
pf=pf+1:IF pf>nn THEN pf=2
LINE (x-d,y-d)-(x+d,y+d),pf,bf ' square
PSET (x-d,y-d),1:PSET (x-d,y+d),1 ' white dots in corners
PSET (x+d,y-d),1:PSET (x+d,y+d),1
WEND
WINDOW CLOSE 2:SCREEN CLOSE 1 ' end
WINDOW 1